Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
15.12.2020 10:21:05 |
Rene |
|
|
Wert in Spalte suchen -> kopieren und auf ein anderes Blatt übertragen |
15.12.2020 10:40:08 |
volti |
|
|
|
15.12.2020 11:01:32 |
Rene |
|
|
|
15.12.2020 11:01:32 |
Rene |
|
|
|
15.12.2020 11:38:21 |
volti |
|
|
|
15.12.2020 13:11:46 |
Rene |
|
|
|
15.12.2020 13:12:17 |
Rene |
|
|
|
15.12.2020 13:12:17 |
Rene |
|
|
|
15.12.2020 13:12:18 |
Rene |
|
|
Von:
volti |
Datum:
15.12.2020 10:40:08 |
Views:
660 |
Rating:
|
Antwort:
|
Thema:
Wert in Spalte suchen -> kopieren und auf ein anderes Blatt übertragen |
Hallo Rene,
da passiert deshalb nichts, weil 12 nicht die Nummer für die Spalte "Q" ist und weil "BaumHaus" nicht "Baum, Haus"entspricht.
Dann stellt sich die Frage: Sind die technischen Blattnamen Tabelle1 und Tabelle2 auch die richtigen oder solltest Du lieber die Registernamen nehmen.
Hier mal zwei Varianten als Idee:
Code:
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60 |
|
Option Explicit
Option Compare Text
Sub BedingteKopieZeilen1()
Dim Zeile As Long
Dim ZeileOut As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With Sheets("Tabelle1")
ZeileOut = 1
For Zeile = 2 To .Cells(Rows.Count, "Q").End(xlUp).Row
If .Cells(Zeile, "Q").Value Like "Haus*Baum" Then
.Rows(Zeile).Copy Destination:=Sheets("Tabelle2").Rows(ZeileOut)
ZeileOut = ZeileOut + 1
End If
Next Zeile
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Sub BedingteKopieZeilen2()
Dim Zeile As Long
Dim ZeileOut As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
With Tabelle1
ZeileOut = 1
For Zeile = 2 To .Cells(Rows.Count, "Q").End(xlUp).Row
If .Cells(Zeile, "Q").Value Like "Haus*Baum" Then
.Rows(Zeile).Copy Destination:=Tabelle2.Rows(ZeileOut)
ZeileOut = ZeileOut + 1
End If
Next Zeile
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
|
_________
viele Grüße
Karl-Heinz
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
15.12.2020 10:21:05 |
Rene |
|
|
Wert in Spalte suchen -> kopieren und auf ein anderes Blatt übertragen |
15.12.2020 10:40:08 |
volti |
|
|
|
15.12.2020 11:01:32 |
Rene |
|
|
|
15.12.2020 11:01:32 |
Rene |
|
|
|
15.12.2020 11:38:21 |
volti |
|
|
|
15.12.2020 13:11:46 |
Rene |
|
|
|
15.12.2020 13:12:17 |
Rene |
|
|
|
15.12.2020 13:12:17 |
Rene |
|
|
|
15.12.2020 13:12:18 |
Rene |
|
|